Forcasting COVID-19 Deaths

A simple model for the estimation of the maximum percentage of deaths due to COVID-19.

NOTE: I’m not an epidiomiologist.

The prediction based on a simple logistic model and:

70% of SARS-CoV-2 exposure
10% Infection efficacy ie. 10% of the exposure subjects turns into a Covid-19 case
1% of Mortality

For each country we will use the urban population

I’ll estimate the death rates based on current trends fitted to the logistic function.
The last 14 days will be used for the peak estimations. Peak estimations will be done using:

If the data has not reached the peak the plots will show estimations based on:

  1. The last reported 14 observations
  2. 14 observations from the last week
  3. 14 observations ending two weeks ago
  4. 14 observations ending three weeks ago
  5. 14 observations ending four weeks ago

If the data reached the peak the plots will show:

  1. all the points after one week before the peak
  2. 14 observations before one week prior the peak
  3. 14 observations ending two weeks prior the peak
  4. 14 observations ending three week prior the peak
  5. 14 observations ending four week prior the peak

We are also providing optimistic models. We assume that the # of fatalities is half the expected.

Notes:

  1. If the current observations does not mach the estimated CDF, do not trust the predictions.
  2. If predicted CDF does not reach 1.0, then there is the potential for more infection in the future or COVID-19 is not as deadly as I estimated

Source code:

https://github.com/joseTamezPena/COVID_Forecasting

# The expetec %  of deaths in each country

expectedtotalFatalities = 0.7*0.1*0.01
optGain <- 2
# The number of observations used for the trends
daysWindow <- 14

today <- Sys.Date()

currentdate <- paste(as.character(today),":")

Loading the data

The data is the time_covid19ing set from CSSE at Johns Hopkins University:

https://github.com/CSSEGISandData/COVID-19/tree/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_deaths_global.csv

Ploting some trends

Country.Region <- rownames(time_covid19Country)
totaldeaths <- as.numeric(time_covid19Country[,ncol(time_covid19Country)])
names(totaldeaths) <- Country.Region
totaldeaths <- totaldeaths[order(-totaldeaths)]


ydata <- as.numeric(time_covid19Country[names(totaldeaths[1]),])
ydata <- ydata[ydata > 1e-6]
plot(ydata,main="# Fatalities",xlab="Days",ylab="Fatalities",xlim=c(1,ncol(time_covid19Country)))
text(length(ydata)-1,ydata[length(ydata)],names(totaldeaths[1]))

for (ctr in names(totaldeaths[1:30]))
{
  ydata <- as.numeric(time_covid19Country[ctr,])
  ydata <- ydata[ydata > 1e-6]
  lines(ydata)
  text(length(ydata)-1,ydata[length(ydata)],ctr)
}


totaldeaths  <- totaldeaths[!is.na(totaldeaths)]
totaldeaths  <- totaldeaths[totaldeaths > 100]

Estimating the peaks